{- This file is part of funbot.
 -
 - Written in 2015, 2017 by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

{-# LANGUAGE OverloadedStrings #-}

module FunBot.Sources.WebListener.GitLab
    ( dispatchGitLab
    )
where

import Control.Monad (when)
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import FunBot.ExtEvents
import Formatting
import FunBot.Sources.WebListener.Util
import Network.URI
import Network.Wai

import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.Lazy.Char8 as BC
import qualified Data.Text as T
import qualified Web.Hook.GitLab as G

makeCommit :: G.Commit -> Commit
makeCommit commit = Commit
    { commitAuthor   = G.authorName $ G.commitAuthor commit
    , commitTitle    = takeLine $ G.commitMessage commit
    , commitUrl      = G.commitUrl commit
    , commitAdded    = [] --G.commitAdded commit
    , commitModified = [] --G.commitModified commit
    , commitRemoved  = [] --G.commitRemoved commit
    }

makeRepo :: G.Project -> Repository
makeRepo proj = Repository
    { repoName  = G.projectName proj
    , repoSpace = uriSpace uri
    , repoHost  = uriHost uri
    }
    where
    uri = parseURI $ T.unpack $ G.projectWebUrl proj

makePush :: G.Push -> ExtEvent
makePush push = GitPushEvent ProjectObject
    { poRepo = makeRepo $ G.pushProject push
    , poObj  = Push
        { pushBranch  = refToBranch $ G.pushRef push
        , pushCommits = map makeCommit $ G.pushCommits push
        }
    }

makeTag :: T.Text -> G.Project -> T.Text -> ExtEvent
makeTag ref proj user = GitTagEvent $ ProjectObject
    { poRepo = makeRepo proj
    , poObj  = Tag
        { tagAuthor = user
        , tagRef    = refToTag ref
        }
    }

makeIssueAction :: G.IssueAction -> T.Text
makeIssueAction G.IssueOpen   = "opened"
makeIssueAction G.IssueUpdate = "updated"
makeIssueAction G.IssueClose  = "closed"

makeIssue :: G.IssueEvent -> ExtEvent
makeIssue ie = IssueEvent ProjectObject
    { poRepo = makeRepo $ G.ieProject ie
    , poObj  = Issue
        { issueAuthor = G.userName $ G.ieUser ie
        , issueId     = G.issueId i
        , issueTitle  = takeLine $ G.issueTitle i
        , issueUrl    = G.issueUrl i
        , issueAction = makeIssueAction $ G.ieAction ie
        }
    }
    where
    i = G.ieIssue ie

makeMR :: G.MergeRequestEvent -> ExtEvent
makeMR mre = MergeRequestEvent ProjectObject
    { poRepo = makeRepo $ G.mrTarget mr
    , poObj  = MergeRequest
        { mrAuthor = G.userName $ G.mreUser mre
        , mrId     = G.mrId mr
        , mrTitle  = takeLine $ G.mrTitle mr
        , mrUrl    = G.mrUrl mr
        , mrAction = G.mreAction mre
        }
    }
    where
    mr = G.mreRequest mre

-- TODO Gogs module has a copy too, move to util module
shorten n t =
    if t `T.compareLength` n == GT
        then T.take n t <> "[…]"
        else t

showNoteTarget :: G.NoteTarget -> T.Text
showNoteTarget (G.NTCommit c) =
    sformat
        ("commit " % stext % " (“" % stext % "”)")
        (T.take 8 $ G.commitId c)
        (shorten 40 $ takeLine $ G.commitMessage c)
showNoteTarget (G.NTIssue i) =
    sformat ("issue #" % int) (G.issueId i)
showNoteTarget (G.NTMergeRequest mr) =
    sformat ("MR !" % int) (G.mrId mr)
showNoteTarget (G.NTSnippet s) =
    sformat ("snippet #" % int) (G.snippetId s)

makeNote :: G.NoteEvent -> ExtEvent
makeNote ne = NoteEvent ProjectObject
    { poRepo = makeRepo $ G.neProject ne
    , poObj  = Note
        { noteAuthor  = G.userName $ G.neUser ne
        , noteContent = shorten 200 $ takeLine $ G.noteNote n
        , noteTarget  = showNoteTarget $ G.neTarget ne
        , noteUrl     = G.noteUrl n
        }
    }
    where
    n = G.neNote ne
    maxlen = 200

dispatchGitLab _ push _pushMany request = do
    rbody <- lazyRequestBody request
    case G.parse $ rbody of
        Left e -> do
            putStr "Web hook source: GitLab: "
            print e
            BC.putStrLn rbody
        Right (G.EventPush e) ->
            push $ makePush e
        Right (G.EventPushTag e) ->
            push $
            makeTag (G.pushRef e) (G.pushProject e) (G.pushUserName e)
        Right (G.EventIssue e) ->
            push $ makeIssue e
        Right (G.EventMergeRequest e) -> do
            let mre@(MergeRequestEvent (ProjectObject _ mr)) = makeMR e
            when (mrAction mr /= "update") $ push mre
        Right (G.EventNote e) ->
            push $ makeNote e
        Right (G.EventPipeline e) ->
            putStrLn "Pipeline event received"
